# Time-stamp: <20 Feb 03 10:53:00 giron1>

=head1 NAME

SIDL_VOCAB - SIDL vocabulary parsing package

=head1 SYNOPSIS

  use SIDL_VOCAB;

$Voc = new SIDL_VOCAB;

$Voc->fillpronunciations;
$Voc->graphem2phonem($lang);
$Voc->phonologyphoneticmap;
$Voc->pronunciationvariants($lang);
$Voc->resolveforeignrefs;
$Voc->duplicateprons;
$Voc->writedic($filename,$format);

=head1 DESCRIPTION

This package manipulates a SIDL vocabulary hash

=head1 SEE ALSO

L<GRAPH2PHONE>,
L<Misc>

=head1 AUTHOR

  $Id: SIDL_VOCAB.pm,v 1.1 2007/10/08 09:26:03 schweitz Exp $
  Franck Giron

=head1 LOG

  $Log: SIDL_VOCAB.pm,v $
  Revision 1.1  2007/10/08 09:26:03  schweitz
  version 2.4, lib vergessen

  Revision /main/16  23-Jul-2003.11:58:47  giron1
  Replacing _SIL_ in phoneme sequence by _sil_.
  
  Revision /main/15  18-Feb-2003.15:57:40  giron1
  Removing the sil entry in the dictionary generation for the
  vrecog option.
  
  Revision /main/14  19-Apr-2002.18:42:31  giron1
  Additional debugging information
  
  Revision /main/13  5-Dec-2001.17:55:41  giron1
  Changed the call to expandphono to reflect the changes
  
  Revision 1.12  2001/07/23 09:18:07  giron1
  Addition of external dictionary reading.
  
  Revision 1.11  2001/03/05 17:02:46  giron1
  sorting and uniq of phonemes descriptions
  
  Revision 1.10  2000/05/12 15:00:08  giron1
  some debugging added
  
  Revision 1.9  2000/04/27 17:22:09  giron1
  Pod documentation extended
  

=cut

package SIDL_VOCAB;

#----------------------------------------------------------------------
# perl packages
#----------------------------------------------------------------------

use strict;
use Misc;
use FileHandle;
use GRAPH2PHONE;

#----------------------------------------------------------------------
# Global variables
#----------------------------------------------------------------------
# Switch to write the language name in front of each phone
my $LANG_PHONE_ENCODE = 0;
# Switch to suppress _ inside of phonemes in output 
# (used to make sampa for diphtong and affricates parseable)
my $STRIP_UNDERSCORES = 0;
# Switch to write escape codes in the graphie instead of ISO characters
my $USE_ESC_ENCODE = 0;

#----------------------------------------------------------------------

=head1 FUNCTIONS

Here are the different available functions

=head2 new

SIDL vocabulary constructor

=cut

#----------------------------------------------------------------------

sub new{
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = {};
  bless $self, $class;
  return $self;
}

#----------------------------------------------------------------------

=head2 setlangphoneencode ($value)

switch whether to include language id ($value=1) or not ($value=0) for
phonemes

=cut

#----------------------------------------------------------------------

sub setlangphoneencode{
  my ($value) = @_;
  $LANG_PHONE_ENCODE = $value;
  warn "setting LANG_PHONE_ENCODE to $LANG_PHONE_ENCODE\n";
}

#----------------------------------------------------------------------

=head2 setstripunderscores ($value)

switch whether to suppress underscores ($value=1) or not ($value=0)
inside phonemes (diphtongs, affricates)

=cut

#----------------------------------------------------------------------

sub setstripunderscores{
  my ($value) = @_;
  $STRIP_UNDERSCORES = $value;
  warn "setting STRIP_UNDERSCORES to $STRIP_UNDERSCORES\n";
}
#----------------------------------------------------------------------

=head2 setuseescencode ($value)

switch whether to use esc codes ($value=1) or not ($value=0)
in the graphie

=cut

#----------------------------------------------------------------------

sub setuseescencode{
  my ($value) = @_;
  $USE_ESC_ENCODE = $value;
  warn "setting USE_ESC_ENCODE to $USE_ESC_ENCODE\n";
}
#----------------------------------------------------------------------

=head2 graphem2phonem ($lang)

grapheme to phoneme conversion of undefined vocabulary

=cut

#----------------------------------------------------------------------

sub graphem2phonem{
  my $Voc = shift;
  my $lang = shift;
  
  my $debug = 1;
  
  my $pcons = 'bdfgklmnNpRsStvwzZ';
  
  # Temporary files for transcription
  my $tmpgraph = "tmpgraph.$lang";
  my $tmpphone = "tmpphone.$lang";
  
  # Finds the words without transcription and
  # writes them in the grapheme temporary file
  my $fhgraph = new FileHandle "> $tmpgraph";
  
  my ($graph,$phone,$i);
 SEARCH_EMPTY: foreach $graph (sort keys %{$Voc->{$lang}}) {
    $phone = $Voc->{$lang}{$graph}[0];
    if (not defined($phone)) {$fhgraph->print("$graph\n"); next SEARCH_EMPTY;}
    $debug and warn "graph: $graph : $phone\n";
    if ($phone eq '_' or $phone =~ m/^:/ ) {next SEARCH_EMPTY;}
    if ($phone eq '') {$fhgraph->print("$graph\n"); next SEARCH_EMPTY;}
    if ($LANG_PHONE_ENCODE) {
      for ($i=0;$i<=$#{$Voc->{$lang}{$graph}};$i++){
        $Voc->{$lang}{$graph}[$i] = "<$lang>" . $Voc->{$lang}{$graph}[$i];
      }
    }
    $debug and warn "trans: $Voc->{$lang}{$graph}[0]\n";
  }
  $fhgraph->close;
  
  # Performs the grapheme to phoneme conversion
  #  system("${lang}_phon.exe < $tmpgraph > $tmpphone");
  if (not defined($ENV{ALIGNERHOME})) {
    die "!! Error:  $0: Please defines your ALIGNERHOME environment variable first !!\n";
  }
  my $apath = "$ENV{ALIGNERHOME}/bin/$lang";
  # Set aligner environment variable to language
  $ENV{ALANG} = $lang;
  system("$apath/graphemephonemeconversion  < $tmpgraph > $tmpphone");
  # Now makes the association between both files
  my $fhphone = new FileHandle "< $tmpphone";
  $fhgraph->open("< $tmpgraph");
  
  while (<$fhgraph>) {
    chop;
    $graph = $_;
    $phone = <$fhphone>;
    chop $phone;
    # suppresses all '<>[]"' characters
    $phone =~ s/[\<\>\[\]\"]//g;
    $debug and warn ">$graph: $phone\n";
    # Performs expansion of phonemic transcription
    my $list = new GRAPH2PHONE;
    $list->expandphono('',$phone,'');
    # Filters the expansion to match really possible cases
    my @varlist = ();
  LOOP: for ($i=0;$i<=$#{$list};$i++) {
      $phone = $list->[$i];
      $debug and warn "_$i: $phone\n";
      # don't consider expressions with liaison or liaison between consonants in French
      next LOOP if ($phone =~ m/\#V\s*$/);
      next LOOP if ($phone =~ m/\#V\s?[$pcons]/);
      next LOOP if ($phone =~ m/\s[$pcons]\s[$pcons]/ );
      # suppresses leading * characters
      #$phone =~ s/^\*+//g;
      # suppresses end spaces
      $phone =~ s/\s+$//g;
      # suppresses liaison symbol
      $phone =~ s/\#V\s?//g;
      # suppresses [ and ] symbols
      $phone =~ s/[\[\]]//g;
      # exchanges spaces with (|#)
      $phone =~ s/\s/\(\#|\)/g;
      # adds spaces between phonemes
	  #      $phone =~ s/([A-Za-z269@\#])/ $1/g;
      # takes care of diphtongs
	  #      $phone =~ s/_\s/_/g; 
      # stores the variant
      if ($LANG_PHONE_ENCODE) { push @varlist,"<$lang>" . $phone;}
      else {push @varlist,$phone;}
      $debug and warn " $i: $phone\n";
    }
    # Sort uniquely the resulting list:
    my @sortlist = sort @varlist;
    @varlist = uniq @sortlist;
	
    # Reinitializes the final list to an empty one
    @{$Voc->{$lang}{$graph}} = ();
    # Copy the results
    foreach (@varlist) {
      push @{$Voc->{$lang}{$graph}}, $_;
    }
    
  }
  $fhgraph->close;
  $fhphone->close;
  
  #  if (-r $tmpphone) {unlink $tmpphone;}
  #  if (-r $tmpgraph) {unlink $tmpgraph;}
  
}

#----------------------------------------------------------------------

=head2 fillpronunciations

dictionary processing: add in native language pronunciations g2p (rulebased)

=cut

#----------------------------------------------------------------------

sub fillpronunciations {
  my $Voc = shift;
  
  my $debug = 0;
  foreach (keys %$Voc) {
    $debug and warn "treating $_:\n";
    $Voc->graphem2phonem($_);
  }
}

#----------------------------------------------------------------------

=head2 phonologyphoneticmap

map from phonological to phonetic layer. (Introduces pronunciation variants.)

=cut

#----------------------------------------------------------------------

sub phonologyphoneticmap{
  my $Voc = shift;
  
  my $debug = 0;
  foreach (keys %$Voc) {
    $debug and warn "treating $_:\n";
    $Voc->pronunciationvariants($_);
  }
}

#----------------------------------------------------------------------

=head2 pronunciationvariants

language specific parts to map from phonological to phonetic layer. 
(Introduces pronunciation variants.)

=cut

#----------------------------------------------------------------------

sub pronunciationvariants{
  my $Voc = shift;
  my $lang = shift;
  
  my $debug = 0;
  
  my $word;
  
  $debug && warn "pronunciation variants for $lang\n";
  
  if ($lang eq 'deu'){
    foreach $word (keys %{$Voc->{$lang}}) {
      $debug && warn "$word, $#{$Voc->{$lang}->{$word}}\n";
      my($i);
      foreach ($i=0; $i<=$#{$Voc->{$lang}{$word}}; $i++){
		$debug and warn "\t@{$Voc->{$lang}->{$word}}[$i]\n";
		@{$Voc->{$lang}->{$word}}[$i] =~ s/\@[Rr]/(\@r|6)/g;
		@{$Voc->{$lang}->{$word}}[$i] =~ s/(E|E:|I|O|O_Y|U|Y|2:|9|a|a:|a_I|a_U|e:|i:|o:|u:|y:)[Rr]/$1(r|6)/g;
		@{$Voc->{$lang}->{$word}}[$i] =~ s/\@[n]/(\@n|n)/g;
		@{$Voc->{$lang}->{$word}}[$i] =~ s/\@[l]/(\@l|l)/g;
		if ($word =~ /^[Cc]h/) {
		  @{$Voc->{$lang}->{$word}}[$i] =~ s/^ [kC]/ (k|C)/;}
		if ($word =~ /ig$/) {
		  @{$Voc->{$lang}->{$word}}[$i] =~ s/I[kC]$/I(k|C)/;}
		$debug && warn " --->\t@{$Voc->{$lang}->{$word}}[$i]\n";
      }
    }
  }
}

#----------------------------------------------------------------------

=head2 resolveforeignrefs

resolve foreign language references (copies from foreign dic)

=cut

#----------------------------------------------------------------------

sub resolveforeignrefs {
  my $Voc = shift;
  
  my $debug = 0;
  my ($lang,$graph,$phone,$i);
  foreach $lang (keys %$Voc) {
    $debug and warn "treating $lang:\n";
	
    foreach $graph (keys %{$Voc->{$lang}}) {
      # Loops over each graphie
      $debug and warn ">$graph:\n";
      $i = 0;
      do {
		# stop immediately if there is no definition
		last if (not defined($Voc->{$lang}{$graph}[$i]));
		$phone = $Voc->{$lang}{$graph}[$i];
		$debug and warn "$i: $phone\n";
		if ($phone =~ m/^:(\w*)/) {
		  my $flang = $1;
		  $debug and warn "> $flang\n";
		  # Copies all possible variants of the foreign word
		  my $j = 0;
		  while ($Voc->{$flang}{$graph}[$j] ne '' and $j < 10) {
			$Voc->{$lang}{$graph}[$i] = $Voc->{$flang}{$graph}[$j];
			$debug and warn "$i: $Voc->{$flang}{$graph}[$j]\n";
			$i++;
			$j++
		  }
		}
		$i++;
      } while ($phone ne '' and $i < 10)
    }
  }
}

#----------------------------------------------------------------------

=head2 duplicateprons

duplicate pronunciations for words associated with actions (copies
from same dic after removing _action)

=cut

#----------------------------------------------------------------------

sub duplicateprons {
  my $Voc = shift;
  
  my $debug = 0;
  my ($lang,$command);
  foreach $lang (keys %$Voc) {
    $debug and warn "treating $lang:\n";
    foreach $command (keys %{$Voc->{$lang}}) {
      if ($Voc->{$lang}{$command}[0] eq '_') {
		$debug and warn "command: $command : $Voc->{$lang}{$command}[0]\n";
		my $graph = $command;
		$graph =~ s/_[^_]*$//;
		$debug and warn "graph: $graph\n";
		if (defined($Voc->{$lang}{$graph})) {
		  $Voc->{$lang}{$command} = $Voc->{$lang}{$graph};
		  if ($debug) {
			my $i;
			for ($i=0;$i<=$#{$Voc->{$lang}{$command}};$i++) {
			  warn "$i: $Voc->{$lang}{$command}[$i]\n";
			}
		  }
		}
      }
    }
  }
}

#----------------------------------------------------------------------

=head2 $Voc->writedic($filename,$format)

writeout a .dic file

=cut

#----------------------------------------------------------------------

sub writedic {
  my $Voc = shift;
  my ($filename,$format) = @_;
  
  my $debug = 1;
  
  open FILE, ">$filename" || die "cannot open $filename";
  
  my ($lang,$graph);
  my $exp = '';
  foreach $lang (keys %$Voc) {
    $debug and warn "Treating $lang:\n";
    my @graphlist = sort keys %{$Voc->{$lang}};
    foreach $graph (@graphlist) {
      # creates the start of the final expression
      if ($format =~ m/^vrecog/) {$exp = $graph . "\t[$graph]\t";} 
      # loops over all possible pronunciation variants
      $debug and warn "variants for: $graph: ",$#{$Voc->{$lang}{$graph}}+1,"\n";
      for (my $indvar=0;$indvar <= $#{$Voc->{$lang}{$graph}};$indvar++) {
		# creates the start of the final expression
		# for janus each pronunciation variant must
		# be associated with a number
		if ($format eq 'janus')  {
		  if ($indvar == 0) {$exp = "{$graph}\t";}
		  else {$exp = "{$graph($indvar)}\t";}
		} elsif ($format eq 'aibo') {
		  my $indaibo = $indvar+1;
		  $exp = $graph . $indaibo . "\t";
		}
		my $phone = $Voc->{$lang}{$graph}[$indvar];
		
		$debug and warn "phone: $phone\n";
		# suppresses existing spaces between phones
		$phone =~ s/\s+//g;
		next if ($phone eq '');
		
		# create an expansion for each possible pause
		my $phonowpause = new GRAPH2PHONE;
		my $phonlang = '';
		$phonowpause->expandphono('',$phone,'');
		foreach (@$phonowpause) {
		  if ($LANG_PHONE_ENCODE and m/^\<(\w*)\>/) {
			# extract phoneme language info
			warn "$_ matched: $&\n";
			$phonlang =  $1;
			s/^\<\w*\>\s*//;
			$debug and warn "$indvar: $phonlang : $_\n";
		  }
		  # adds spaces between phonemes
		  s/([A-Za-z\{0-9@\#\*])/ $1/g;
		  # takes care of diphtongs
		  s/_\s/_/g; 
		  # suppresses leading spaces
		  s/^ //;
		  # replaces * characters by _sil_
		  s/\*/_sil_/g;	  
		  # strip underscores inside phonemes (but keep e.g. _sil_ and _6's)
		  if ($STRIP_UNDERSCORES) {
			my @phon = split / /, $_;
			$_ = '';
			my $phoneme;
			foreach $phoneme (@phon) {
			  $phoneme =~ s/(.)_(?=.)/$1/g;
			  $_ .= "$phoneme ";
			}
			#	    undef @phon;
		  }
		  # attaches phoneme language info to all phonemes
		  if ($LANG_PHONE_ENCODE and $phonlang ne '') {
			my @phon = split / /, $_;
			$_ = '';
			my $phoneme;
			foreach $phoneme (@phon) {
			  $debug and warn "$phoneme\n";
			  if ($phoneme eq '#' ) {$_ .= "$phoneme ";}
			  else {$_ .= "${phonlang}_$phoneme ";}
			}
			#	    undef @phon;
		  }
		  # exchange # symbol with _SIL_
		  s/\#/_SIL_/g;
		  if (!$LANG_PHONE_ENCODE) {s/([0-9])/_$1/g;}
		  if ($format eq 'janus') {$_ = "{$_}";}
		  # replaces iso accented characters with esc codes
		  if ($USE_ESC_ENCODE) {$exp = iso_to_esc('\\',$exp);}
		  my $result = $exp . $_;
		  $debug and warn "$result\n";
		  print FILE "$result\n";
		}
      }
    }
    if ($format eq 'vrecog_nbest') {
      foreach (my $i=0; $i <= $#graphlist; $i++) {
		print FILE "!EXIT$i\t[]\t_sil_\n";
      }
    } 
  }
  if ($format =~ m/^vrecog/) {
    # Write final lines
    print FILE "_SIL_\t[_SIL_]\t_sil_\n",
	"!ENTER\t[]\t_sil_\n",
	"!EXIT\t[]\t_sil_\n";
  }
  
  close FILE;
}

#----------------------------------------------------------------------

=head2 $Voc->readdic($filename,$format)

read a .dic file

=cut

#----------------------------------------------------------------------

sub readdic {
  my $Voc = shift;
  my ($filename,$format) = @_;
  
  my $debug = 0;
  
  open FILE, "<$filename" || die "cannot open $filename";
  
  my ($lang,$graph,$phone);
  while (<FILE>) {
    m/^(\S+)\s+\[\S+\]\s+(.*)$/;
    $graph = $1;
    $phone = $2;
    if (exists($Voc->{$graph})) {
      push @{$Voc->{$graph}},$phone;
    } else {
      $Voc->{$graph}[0] = $phone;
    }
  }
}
 
1;
